perm filename PIX.SAI[PIX,HPM]7 blob
sn#055900 filedate 1973-07-30 generic text, type T, neo UTF8
00100 BEGIN "PIX"
00200
00300 REQUIRE "HELIB[1,3]" LIBRARY;
00400 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00500 REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
00600 REQUIRE 2000 STRING_SPACE;
00700 REQUIRE "⊂⊃||" DELIMITERS;
00800
00900 DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
01000 CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
01100 RED=⊂0⊃, BLUE=⊂1⊃, GREEN=⊂2⊃, CLEAR=⊂3⊃;
01200 EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INT ARRAY STOR);
01300 EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
01400 EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
01500 EXT PRO RELCOR(INT IOWD);
01600 EXT INT PRO GETCOR(INT SIZE);
01700 EXT PRO INP;
01800 EXT INT PRO GIOWD(INT ARRAY BUF);
01900 EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
02000 EXT PRO CWHEEL(INT CODE);
02100 EXT PRO TVIN;
02200 EXT PRO PRDUMP;
02300 EXT PRO PORTR;
02400 EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
02500 EXTERNAL PROCEDURE CALLEN;
02600 EXTERNAL PROCEDURE SPWOFF;
02700 EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
02800 L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS,TVCAM,ERROR;
02900
03000 SAFE INT ARRAY PNTRS[1:25];
03100 SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
03200 MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
03300 INT N, LIN, LINN, I, II, III, ANS, TVLENG, RFNAM, RFNUM, SEQNO;
03400 REAL PANPOT, FOCPOT, TILPOT;
03500 LABEL RUSE, LOOP, TKE, SKE;
03600 STRING STR, INS;
03700 PRELOAD_WITH "R","B","G"; STRING ARRAY CFIRST[1:3];
03800 SAFE INTEGER ARRAY PICALLOC[1:3]; α allocation table for data blocks;
03900 α first we initialize the world;
03950 ERROR ← 1; α NEVER ERR OUT ON TVIN ERRORS ;
04000 OUTSTR("TYPE ? FOR HELP"&CRLF);
04100 SEQNO←0;
04200 QUICK_CODE '051000000000 '10,0; END;
04300 INS ← INCHWL;
04400 CLRBUF;
04500 WHILE LENGTH(INS) ≥ 2 ∧ INS[1 TO 1] ≠ ";" DO INS ← INS[2 TO ∞];
04600 LIN ← IF INS[1 TO 1]=";" THEN CVO(INS[2 TO ∞]) ELSE '15;
04700 LINN ← '401;
04800 LOOP: TVCAM ← IF (LIN LAND 7) = 1 THEN 1 ELSE
04900 IF (LIN LAND 7) = 2 THEN 2 ELSE
05000 IF (LIN LAND 7) = 3 THEN 3 ELSE 0;
05100 START_CODE
05200 LABEL XX1,GOO;
05300 JRST GOO;
05400 XX1: '401000000000 LIN;
05500 GOO: HRLZ 1,LINN;
05700 IOR 1,XX1;
05800 CALLI 1,'400070;
05900 SKIP 0;
06000 END;
06100 TCLIP ← 0;
06200 BCLIP ← 7;
06300 PICALLOC[1] ← PICALLOC[2] ← PICALLOC[3] ← PNTRS[1] ← 0;
06400 ARRBLT(PNTRS[2],PNTRS[1],24);
06500 FLINE←'13;
06600 LLINE←'373;
06700 RSIDE←'450;
06800 LSIDE←'13;
06900 TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
07000 PICALLOC[1] ← GETCOR(TVLENG);
07100 IF TVCAM = 1 THEN
07200 BEGIN
07300 PICALLOC[2]←GETCOR(TVLENG);
07400 PICALLOC[3]←GETCOR(TVLENG);
07500 END;
07600 IF (RFNUM ← RFNUM - 1)≥0 THEN
07700 BEGIN
07800 I←'40;
07900 GO TO TKE;
08000 END;
08100 OUTSTR("*");
08200 IF (I ← INCHRW) = '175 THEN
08300 BEGIN
08400 OUTSTR("CHANNEL=");
08500 LIN←CVO(INCHWL);
08600 IF LIN≥'40 THEN LIN←LIN LAND '17
08700 ELSE LIN←1 LSH (35-LIN);
08800 GO TO RUSE;
08900 END ELSE
09000 IF I = '12 THEN
09100 BEGIN
09200 OUTSTR("LINE=");
09300 LINN←CVO(INCHWL);
09400 GO TO RUSE;
09500 END ELSE
09600 IF I = "?" THEN
09700 BEGIN
09800 OUTSTR(CRLF&"THIS PROGRAM ALLOWS YOU TO SNAP DDVID
09900 COMPATIBLE PICTURES FROM ANY VIDEO SOURCE
10000 WITH A MINIMUM OF FUSS. THE DEFAULT SOURCE
10100 (CHANNEL) IS THE TV RECIEVER IN THE LOUNGE
10200
10300 TYPE SPACE TO TAKE A PICTURE
10400
10500 TYPE A DIGIT FOR RAPID FIRE MODE
10600 n FILES CALLED PIXn.mmm WILL BE PRODUCED
10700 (n BEING YOUR DIGIT, AND mmm A SEQUENCE
10800 NUMBER), ONE EVERY FEW SECONDS
10900
11000 FOR CHAN 51 (THE OLD HAND EYE CAMERA)
11100 YOU MAY ALSO TYPE
11200 C - TO TAKE A COLOR PICTURE (THREE FILES)
11300 {R,G,B} - TO TAKE A FILTERED PICTURE
11400
11500 TYPE ALTMODE TO CHANGE CHANNEL
11600 CHANNELS ARE:
11700 47 - VIDEO SYNTHESIZER
11800 51 - OLD (COHU) HAND EYE CAMERA
11900 52 - NEW (SIERRA) HAND EYE CAMERA
12000 53 - BAUMGART'S LINE (THE FONT CAMERA, MAYBE)
12100 55 - LOUNGE TV RECEIVER
12200 nn - ANY DD CHANNEL YOU CAN LOOK AT WITH <ESC>nnS
12300
12400 IF YOU DECIDE YOU DON'T WANT A PICTURE AFTER ALL
12500 SIMPLY ANSWER THE 'FILE=' WITH A CARRIAGE RETURN,
12600 OTHERWISE NAME A FILE FOR IT TO BE STORED ON
12700
12800 YOU MAY MONITOR THE PICTURE TAKING PROCESS AT
12900 DD TERMINALS BY HITTING <ESC>54S. THE DIGITIZER
13000 CURSOR WILL CAUSE THE IMAGE TO FLASH AS A FRAME
13100 IS TAKEN"&CRLF);
13200 CLRBUF;
13300 GO TO RUSE;
13400 END ELSE
13500 IF I≥"0" ∧ I≤"9" THEN
13600 BEGIN
13700 RFNUM←(RFNAM←I)-"0";
13800 GO TO RUSE;
13900 END;
14000 TKE: I ← IF I > '140 ∧ I < '173 THEN I - '40 ELSE I;
14100 II ← IF I = '103 THEN RED ELSE
14200 IF I = '102 THEN BLUE ELSE
14300 IF I = '107 THEN GREEN ELSE
14400 IF I = '122 THEN RED ELSE CLEAR;
14500 III ← IF I = '103 ∧ TVCAM = 1 THEN GREEN ELSE II;
14600 N ← 0;
14700 FOR I ← II STEP 1 UNTIL III DO
14800 BEGIN EXTERNAL INTEGER IND;
14900 IF TVCAM = 1 THEN
15000 BEGIN
15100 CWHEEL(6);
15200 IF IND ≠ I THEN
15300 BEGIN INTEGER M;
15400 CWHEEL(I);
15500 M ← 12000;
15600 WHILE M ← M - 1 DO;
15700 END;
15800 END;
15900 TVWORD ← PICALLOC[N ← N + 1];
16000 TVIN;
16100 END;
16200 BEGIN "DSKOUT"
16300 INTEGER FILE, PPN, EXTEN, FAIL;
16400 STRING FILOUT;
16500 LABEL LOOP3;
16600 LOOP3: IF RFNUM≥0 THEN
16700 BEGIN
16800 STR←"PIX"&RFNAM&"."&CVS(SEQNO←SEQNO+1);
16900 GO TO SKE;
17000 END;
17100 OUTSTR("FILE=");
17200 STR ← INCHWL;
17300 SKE: IF LENGTH(STR)≠0 THEN
17400 FOR I ← 1 STEP 1 UNTIL III-II+1 DO
17500 BEGIN
17600 PNTRS[1]←PICALLOC[I];
17700 FILOUT←IF II=III THEN STR ELSE CFIRST[I]&STR;
17800 FILE←CVFIL(FILOUT,EXTEN,PPN);
17900 PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
18000 IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "
18100 &FILOUT&" FAILED"); GO TO LOOP3;END;
18200 OUTSTR("FILE "&FILOUT&" WRITTEN OUT"&CRLF);
18300 END;
18400 END "DSKOUT";
18500 α return for next picture;
18600
18700 RUSE: FOR I ← 1 STEP 1 UNTIL 3 DO
18800 BEGIN
18900 IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
19000 PICALLOC[I] ← PNTRS[I] ← 0;
19100 END;
19200 GO TO LOOP;
19300 END;